home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 1999 January / PC Plus Super CD No55a (PCP-147A-1-99) (Disc 1) (1998).iso / linux / developers / visualtcl / windows / vtcl / demo / tclet-draw.tcl < prev    next >
Encoding:
Text File  |  1997-03-27  |  8.3 KB  |  255 lines
  1. #################################
  2. # GLOBAL VARIABLES
  3. #
  4. global img; 
  5.     set img(line) {
  6.     R0lGODdhKAAoAPUAAAAAADj4MEDsMEjkMFBQ+FDcMFjQMGDIMGjAMHB0cHC4MHikOHisMIB8
  7.     eICAgICcOIiQOJCIOJiAOKB4OKC0yKDEyKgoGKhsOLBkOLhcOLi4uMBQOMDAwMhIOMjEwNBA
  8.     ONg4ONh8eOAsOOC4gOgkOPAcOPC4OPgUQPiIOPj8+AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
  9.     AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACwAAAAAKAAoAAAG
  10.     f8CUcEgsGo/IpHLJbDqf0Kj0CKhOo9Us4NrUerlJrxhc1KbM5yw5vRV+2e2r2t22DtFYO31f
  11.     jj/nd3F6XICBhmCFh2xrVH5pjEaDj5BEkpOUl4qUlplrnJ1kn4mIjpWlhKd8jJ+qoamtmJGs
  12.     sbOYtbavtLm4sb2+v8DBwsPEv0EAOw==
  13. }
  14.     set img(rect) {
  15.     R0lGODdhKAAoAPUAAAAAADj4MEDsMEjkMFBQ+FDcMFjQMGDIMGjAMHB0cHC4MHikOHisMIB8
  16.     eICAgICcOIiQOJCIOJiAOKB4OKC0yKDEyKgoGKhsOLBkOLhcOLi4uMBQOMDAwMhIOMjEwNBA
  17.     ONg4ONh8eOAsOOC4gOgkOPAcOPC4OPgUQPiIOPj8+AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
  18.     AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACwAAAAAKAAoAAAG
  19.     XsCUcEgsGo/IpHLJbDqf0Kh0Sq1ar9isdsvtOgHgsHhMBkfLaPQZMDVD3eu4FP5lz+1Peh5f
  20.     b/Oben1vf4J7fnKIhYOJhot3jIqAaZNha5STXpmam5ydnp+goaKjVkEAOw==
  21. }
  22.     set img(oval) {
  23.     R0lGODdhKAAoAPUAAAAAADj4MEDsMEjkMFBQ+FDcMFjQMGDIMGjAMHB0cHC4MHikOHisMIB8
  24.     eICAgICcOIiQOJCIOJiAOKB4OKC0yKDEyKgoGKhsOLBkOLhcOLi4uMBQOMDAwMhIOMjEwNBA
  25.     ONg4ONh8eOAsOOC4gOgkOPAcOPC4OPgUQPiIOPj8+AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
  26.     AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACwAAAAAKAAoAAAG
  27.     YsCUcEgsGo/IpHLJbDqf0Kh0Sq1ar9isdstVAr5gQDcFPpax32a6Koa2pW83nC23xpf3uTqb
  28.     N/P3aIBXfX52T4SHdVOISYyNVI5GkV6Ta4OWRGdcYZpjnp+goaKjpKWmp11BADs=
  29. }
  30.     set img(free) {
  31.     R0lGODdhKAAoAPcAAAAAALi4uNh8eOC4gPC4OPj8+AEUAEAIAMg0E6D4ABT/AAi/ABA1Aa+y
  32.     ABQBAAhAAMQsuKeppxQUFAgICMi04DL39gj//0C/vw4EwMAA9gEA/0AAv1DIbwEytQAIAQBA
  33.     QDjIyKigoBDIEK+gr+AkvPivp/8UFL8ICDEb5v22pwIAFEAACDYEEKgArxQAFAgACGjInrSg
  34.     vQwUAQgIQMFkG4r4AA3/AEC/AIwEDVoAABQAAEAAAADIGACgAAAUAAQIADBw/Nb4pxD/FAy/
  35.     CDA1HNay9xAB/whAv+gETskAkhEAB1DInqigvRQUATgEG6gAAAgAAMjIDTKgAAgUAPyIGPj4
  36.     AP//AL+/AJQ1BLWyqAQBFEBACAnQHACn9wAU/wAIvwgIgKf4khT/Bwi/CEwEyAIAoAAAFAAA
  37.     CMjIgzIyAAgIAEBABRjIEPmgr8TIG7+gAAQUAIAkEKavABQUAAgbGae2AEwEEgIAAGS4KPn4
  38.     9////7+/v701LnmymggBBwhACGwE8MKozwwUEwA4AQD4AAD/AAC/ANgENfkAJ/8AEb8ACLDI
  39.     OA0y9xYI/8jIFTKgjQgUB0AICNTIrPmgzf8UE9gkhPmv/P8U/78Iv7AAOA0A+hYA/wgAv5TI
  40.     v/mggf8UBaAQDayvAAcUAAAgAACpAAAIAAHIhAAy/AAI/wBAvygOhADA/AAB/yhSqAAB+QAA
  41.     /wAAvwCkAAAQAAGvANyMAPn4ANgxAPn9AP8CAL9AAJSahPmp/Nz8JKz4rwf/FLAKGw0AthYA
  42.     ACjsTwAAdgAAZQAAcihudwAAaQAFdAAHZQD5IAD/ZQC/eIQKafwAc/8AdL8AaQCgBABvyAC1
  43.     oAABFABACAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
  44.     AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
  45.     AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACwAAAAAKAAoAAAIngALCBxIsKDBgwgTKlzIsKHD
  46.     hxAjSlQIoOLEiAAEaARw8WHGjR0bVgQZkiGAABk5lqQYoKXKlQkruoQZk0DFlzQNAiDAE2fO
  47.     gTt7/jwY1ObQgkV9Hk16lCDTpkB5GoVa4ClVq02xZpWq9KfWpVxNdvxKdOyAAVPFTgRwtitC
  48.     tyYterwod+5YpHWRlnzJVyfMm3hvwqVKuLDhw4gTNw0IADs=
  49. }
  50. global tool; set tool {free}
  51. global widget; 
  52.     set widget(rev,.01.02) {CANVAS}
  53.     set widget(CANVAS) {.01.02}
  54.     set widget(rev,.top28.fra29.can30) {CANVAS}
  55.     set widget(rev,.tclet.01) {CANVAS}
  56. global x; set x {224}
  57. global y; set y {181}
  58.  
  59. #################################
  60. # USER DEFINED PROCEDURES
  61. #
  62. proc init {argc argv} {
  63. global vTcl tcl_platform tcl_version tk_strictMotif img
  64. catch {package require unsafe}
  65. set tk_strictMotif 1
  66.  
  67. if {$tcl_version < 7.7} {
  68.     if {[info exists vTcl(VTCL_DIR)]} {
  69.         set base [file join $vTcl(VTCL_DIR) demo]
  70.     } else {
  71.         set base [pwd]
  72.     }
  73.     image create photo free -file [file join $base images free.gif]
  74.     image create photo line -file [file join $base images line.gif]
  75.     image create photo rect -file [file join $base images rect.gif]
  76.     image create photo oval -file [file join $base images oval.gif]
  77. } else {
  78.     foreach i {free line rect oval} {
  79.         image create photo $i -data $img($i)
  80.     }
  81. }
  82. }
  83.  
  84. init $argc $argv
  85.  
  86.  
  87. proc button-down {sx sy} {
  88. global tool x y obj widget
  89.  
  90. switch $tool {
  91.     free -
  92.     line {
  93.         set x $sx
  94.         set y $sy
  95.         set obj [$widget(CANVAS) create line $x $y $x $y]
  96.     }
  97.     rect {
  98.         set x $sx
  99.         set y $sy
  100.         set obj [$widget(CANVAS) create rectangle $x $y $x $y]
  101.     }
  102.     ellipse {
  103.         set x $sx
  104.         set y $sy
  105.         set obj [$widget(CANVAS) create arc $x $y $x $y -start 0 -extent 359 -style arc]
  106.     }
  107. }
  108. }
  109.  
  110. proc button-motion {nx ny} {
  111. global tool x y obj widget
  112.  
  113. switch $tool {
  114.     free {
  115.         $widget(CANVAS) create line $x $y $nx $ny
  116.         set x $nx
  117.         set y $ny
  118.     }
  119.     line -
  120.     rect -
  121.     ellipse {
  122.         $widget(CANVAS) coords $obj $x $y $nx $ny
  123.     }
  124. }
  125. }
  126.  
  127. proc button-release {nx ny} {
  128. global tool x y
  129.  
  130. switch $tool {
  131. }
  132. }
  133.  
  134. proc main {argc argv} {
  135.  
  136. }
  137.  
  138. proc Window {args} {
  139. global vTcl
  140.     set cmd [lindex $args 0]
  141.     set name [lindex $args 1]
  142.     set rest [lrange $args 2 end]
  143.     if {$name == "" || $cmd == ""} {return}
  144.     set exists [winfo exists $name]
  145.     switch $cmd {
  146.         show {
  147.             if {[info procs vTclWindow(pre)$name] != ""} {
  148.                 vTclWindow(pre)$name $rest
  149.             }
  150.             if {[info procs vTclWindow$name] != ""} {
  151.                 vTclWindow$name
  152.             }
  153.             if {[info procs vTclWindow(post)$name] != ""} {
  154.                 vTclWindow(post)$name $rest
  155.             }
  156.         }
  157.         hide    { if $exists {wm withdraw $name; return} }
  158.         iconify { if $exists {wm iconify $name; return} }
  159.         destroy { if $exists {destroy $name; return} }
  160.     }
  161. }
  162.  
  163. #################################
  164. # VTCL GENERATED GUI PROCEDURES
  165. #
  166. frame .01 \
  167.     -borderwidth 1 -height 30 -relief raised -width 30 
  168. pack .01 \
  169.     -anchor center -expand 1 -fill both -padx 5 -pady 5 -side top 
  170. canvas .01.02 \
  171.     -borderwidth 2 -height 246 -highlightthickness 0 -relief ridge -width 351 
  172. grid .01.02 \
  173.     -column 0 -row 0 -columnspan 1 -rowspan 6 -padx 5 -pady 5 -sticky nesw 
  174. bind .01.02 <ButtonRelease-1> "
  175.         button-release %x %y
  176.     "
  177. bind .01.02 <B1-Motion> "
  178.         button-motion %x %y
  179.     "
  180. bind .01.02 <Button-1> "
  181.         button-down %x %y
  182.     "
  183.  
  184. frame .01.03 \
  185.     -borderwidth 1 -height 30 -relief sunken -width 30 
  186. grid .01.03 \
  187.     -column 1 -row 0 -columnspan 1 -rowspan 1 -padx 5 -pady 5 -sticky n 
  188. button .01.03.04 \
  189.     -command {set tool free} \
  190.     -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*-* \
  191.     -highlightthickness 0 -image free -padx 11 -pady 4 -text free 
  192. pack .01.03.04 \
  193.     -anchor center -expand 1 -fill both -side top 
  194.  
  195. button .01.03.05 \
  196.     -command {set tool line} \
  197.     -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*-* \
  198.     -highlightthickness 0 -image line -padx 11 -pady 4 -text line 
  199. pack .01.03.05 \
  200.     -anchor center -expand 1 -fill both -side top 
  201.  
  202. button .01.03.06 \
  203.     -command {set tool rect} \
  204.     -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*-* \
  205.     -highlightthickness 0 -image rect -padx 11 -pady 4 -text rect 
  206. pack .01.03.06 \
  207.     -anchor center -expand 1 -fill both -side top 
  208.  
  209. button .01.03.07 \
  210.     -command {set tool ellipse} \
  211.     -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*-* \
  212.     -highlightthickness 0 -image oval -padx 11 -pady 4 -text ellipse 
  213. pack .01.03.07 \
  214.     -anchor center -expand 1 -fill both -side top 
  215.  
  216.  
  217. frame .01.08 \
  218.     -borderwidth 2 -height 45 -relief groove -width 45 
  219. grid .01.08 \
  220.     -column 1 -row 1 -columnspan 1 -rowspan 1 -padx 5 -pady 5 
  221. frame .01.08.09 \
  222.     -background #ffffff -borderwidth 1 -height 30 -relief raised -width 30 
  223. place .01.08.09 \
  224.     -x 15 -y 15 -width 25 -height 25 -anchor nw -bordermode ignore 
  225.  
  226. frame .01.08.010 \
  227.     -background #000000 -borderwidth 1 -height 30 -relief raised -width 30 
  228. place .01.08.010 \
  229.     -x 5 -y 5 -width 25 -height 25 -anchor nw -bordermode ignore 
  230.  
  231.  
  232. label .01.011 \
  233.     -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*-* -text select 
  234. grid .01.011 \
  235.     -column 1 -row 3 -columnspan 1 -rowspan 1 
  236.  
  237. label .01.012 \
  238.     -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*-* -text {a tool} 
  239. grid .01.012 \
  240.     -column 1 -row 4 -columnspan 1 -rowspan 1 
  241.  
  242. button .01.013 \
  243.     -command exit -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*-* \
  244.     -highlightthickness 0 -padx 9 -pady 3 -text Quit 
  245. grid .01.013 \
  246.     -column 1 -row 5 -columnspan 1 -rowspan 1 -padx 5 -pady 5 -sticky ns 
  247.  
  248. grid columnconf .01 0 -weight 1
  249. grid columnconf .01 1 -minsize 45
  250. grid rowconf .01 5 -weight 1
  251. grid rowconf .01 1 -minsize 45
  252.  
  253.  
  254. main $argc $argv
  255.